;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
;;;
;;; *************************************************************************
;;; Copyright (c) 1985 Xerox Corporation.  All rights reserved.
;;;
;;; Use and copying of this software and preparation of derivative works
;;; based upon this software are permitted.  Any distribution of this
;;; software or derivative works must comply with all applicable United
;;; States export control laws.
;;; 
;;; This software is made available AS IS, and Xerox Corporation makes no
;;; warranty about the software, its performance or its conformity to any
;;; specification.
;;; 
;;; Any person obtaining a copy of this software is requested to send their
;;; name and post office or electronic mail address to:
;;;   CommonLoops Coordinator
;;;   Xerox Artifical Intelligence Systems
;;;   2400 Hanover St.
;;;   Palo Alto, CA 94303
;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
;;;
;;; Suggestions, comments and requests for improvements are also welcome.
;;; *************************************************************************
;;;
;;; This file contains the actual method combinations, and some stuff that
;;; can't happen until the actual method combinations are defined.

  ;;   
;;;;;; Actual method combinations.
  ;;

;;;
;;; Note:                                                           
;;;   I am not really sure what single-arg-is-value is all about it seems
;;;   to me to be a hack to help out the compiler.  I don't that this is
;;;   the place to declare the single-arg-is-valueness of a function, or
;;;   that combining methods is the place to do what rightly should be a
;;;   compiler optimization.
;;;   As proof, suppose that we were taken over by religious fanatics who
;;;   said that and and or should always return #!YOW! or #!FALSE!.  Then
;;;   you would have to change the definition of :and method combination
;;;   and the compiler to know that :and wasn't single arg is value any
;;;   more (of course you would have to change the rest of the world to,
;;;   but that is beside the point).
;;; 

(define-simple-method-combination :progn progn t)
(define-simple-method-combination :or or t)
(define-simple-method-combination :and and t)
(define-simple-method-combination :list list)
(define-simple-method-combination :append append)

(define-method-combination :daemon (&optional (order ':most-specific-first))
          ((before "before" :every :most-specific-first (:before))
           (primary "primary" :first order () :default)
           (after "after" :every :most-specific-last (:after)))
  (:causes-combination-predicate daemon-method-causes-combination-p)
  `(multiple-value-prog1
     (progn (call-component-methods ,before)

            (call-component-method ,primary))
     (call-component-methods ,after)))

(defun daemon-method-causes-combination-p (method)
  (not (null (method-options method))))

(defmeth method-causes-combination-p ((method combinable-method-mixin))
  (funcall
    (method-causes-combination-predicate (method-discriminator method))
    method))